perm filename TRNSP.F4[PAG,LCS]4 blob
sn#493289 filedate 1980-01-14 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 C**** TRNSP, RVRS, BMGHT, CUES ***************
C00024 ENDMK
C⊗;
C**** TRNSP, RVRS, BMGHT, CUES ***************
SUBROUTINE TRNSP
COMMON /PX/KPN(1) /Q/Q(1) /XRN/RN(1)
COMMON/STF/RSTFAC(0/7),RSTJ2 /IPG/IPG,JPG,BRACK(8),
1 RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(0/7)
1 /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,IRV,ITR
COMMON /FIN/JBAR,NPX,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
1,LC,LPG,MPG,ZCLEF,SIG,LB,SPG,MTR1,MTR2
1 /LLL/LEND,NO1,NI,NO3,XSIG /RSIG/RSIG(0/7)
1 /TRAN/RTR(17),KTR(17)
DATA RTR/5.,5.,4.,4.,3., 2.,2.,1.,1.,1., -1.,-1.,-2.,-2.,-3.
1 ,-4.,8./,KTR/3,-4,1,-6,-1, 4,-3,2,-5,0, 5,-2,3,-4,1, -1,2/
IOCT=0
RXT=99.
KW=0
IF(ITR.LE.17)GO TO 1002
IADD=0
RT=7
C OCTAVE ↑ = 19, - = 18
IF(ITR.EQ.18)RT=-RT
IOCT=-1
GO TO 199
1002 IF(SIG.NE.-99)GO TO 199
C FOUND KSIG, SO DON'T DO THE REST
IF(XSIG.NE.0)GO TO 2002
RT=0
IF(ITR.EQ.0)RETURN
RT=RTR(ITR)
C EEb,EE,F-,F#-,G, Ab,A,Bb,B,DMY, Db,D,Eb,E,F,G↑ BBb, 8-, 8↑
41 NSIG=-1
IF(RSIG(KW).NE.99)GO TO 699
C ASSUMES KSIG DESIRED IF ONE THERE ALREADY.
IF(ZSIG(XSIG).NE.'Y')GO TO 199
C FUNCTION ZSIG ASKS 'ADD KEY SIG?'
699 NSIG=0
XSIG=99
C ***** NEXT FOR KEY SIG. ********
IADD=KTR(ITR)
C EEb,EE,F-,F#-,G, Ab,A,Bb,B,DMY, Db,D,Eb,E,F,G↑ BBb, 8-, 8↑
2002 K=0
2003 R=0
RZ=RSIG(K)
IF(RZ.NE.99)R=RZ
R=IADD+R
IF(R.EQ.0)GO TO 799
A=ABS(R)
IF(A.LT.8.OR.A.GE.100)GO TO 899
C IF IMPOSSIBLE KSIG, DO ENHARMONIC SHIFT (NATURALS KSIG IS OK)
IF(R.LT.0)GO TO 1899
R=R-12
ITR=9
RT=RT+1
GO TO 899
1899 R=R+12
ITR=11
RT=RT-1
899 IF(IPG.GT.0)GO TO 799
C SKIP IF TRNSP ONLY.
IF(RZ.NE.99)GO TO 799
SIG=0
CALL STAFF(4.,17.,4.0*RSTJ2,0,R,CLEF,0,0,0,0,0,0)
799 RSIG(K)=R
K=K+1
IF(K.LT.JPG)GO TO 2003
199 K=1
CC CLEF=RCLEF(KW)
SLUR=0
PRX=99
MS=200
SN=KW
599 X=CODEN(KPN,K,Q,J)
IF(X.EQ.4)GO TO 2
IF(Q(J+2).NE.SN)GO TO 100
CHECK FOR STAFF NUM.
IF(X.EQ.1)GO TO 1
IF(X.NE.3)GO TO 20
CC IF(IPG.GT.0)GO TO 100
CLEF=Q(J+5)
IF(Q(J).LT.3)CLEF=0
CIRC IF(ITR.EQ.16.OR.ITR.EQ.3)GO TO 21
IF(ITR.NE.17.AND.ITR.NE.3)GO TO 100
C NEXT FOR HORN IN F CLEF CHANGES**** NOW ONLY BS.CLAR 10/79
CIRC GO TO 100
C NEXT FOR BASS CL. CLEF CHANGES.
21 IF(CLEF.NE.0)Q(J+5)=0
IF(RXT.NE.99.)RXT=RT
C RESET DISPLACEMENT WHEN PART IS IN TREBLE CLEF.
IF(Q(J+4).LT.100.)GO TO 100
CALL SHRNK(K,LEND)
C MAKE IT INVISIBLE IF IT WAS MINI.
GO TO 599
2 BAR=-1
MS=200
GO TO 100
20 IF(X.NE.17)GO TO 12
C HOW ABOUT CHANGE TO NO SIG? OK, CODE =99
R=Q(J+5)
C KSIG NUM.
A=R+IADD
CHANGED TO A
CIRC IF(A.GE.8)A=A-12
CIRC IF(A.LE.-8)A=A+12
CIRC IF(A.NE.0)GO TO 23
CIRC A=100
CHANGE KSIG TO NATURALS
CIRC IF(R)A=-A
CIRC A=R+A
CIRC RSIG(KW)=A
CC RSIG(KW)=99
IF(ABS(A).LT.8)GO TO 423
C AVOIDS IMPOSSIBLE KSIG, DOES ENHARMONIC CHANGE.
IF(A.LT.0)GO TO 223
ITR=9
A=A-12
RT=RT+1
GO TO 423
223 A=A+12
ITR=11
RT=RT-1
423 IF(A.NE.0)GO TO 23
M=Q(J)+3
C THIS WILL DELETE KSIG
ITOT=KPN(LEND+1)-1
323 ITOT=ITOT-M
KL=ITOT-J+1
CALL RLOOP(Q(J),Q(J+M),KL)
DO 334 J=K,LEND
334 KPN(J)=KPN(J+1)-M
LEND=LEND-1
NI=NI-1
C NI IS I IN WRTPAG.
K=K-1
GO TO 100
23 Q(J+5)=A
IF(ITR.NE.17.AND.ITR.NE.3)GO TO 523
IF(CLEF.EQ.1.)Q(J+6)=0
C PUTS HORN AND BS.CLAR BASS CLEF KEY SIG UP TO TREB. POSITION
523 NSIG=0
12 IF(X.NE.5)GO TO 123
SLUR=Q(J+6)
GO TO 121
C SAVES RIGHT POS. OF SLUR
123 IF(X.NE.6)GO TO 100
121 A=RT
C FOR BEAMS AND SLURS
CIRC IF(A.EQ.8)GO TO 122
CIRC IF(A.NE.4)GO TO 124
IF(ITR.NE.17.AND.ITR.NE.3)GO TO 124
C A=8=BS.CL. =4=HRN MOVES BEAMS AND SLURS IF CLEF CHANGE
122 IF(CLEF.EQ.1)A=A-12
C BASS CLEF → TREBLE
124 Q(J+4)=Q(J+4)+A
Q(J+5)=Q(J+5)+A
C ASSUMES NO CLEF CHANGE BETWEEN END POINTS OF SLUR OR BEAM.
GO TO 100
1 IF(Q(J).GE.7.AND.Q(J+9).LT.0)GO TO 100
C IF P9 IS NEG. IT'S A NOTE WITHOUT LEDGER LINES. IGNORE IT.
R=Q(J+4)
XRT=RT
IF(Q(J).LT.6)GO TO 111
C SKIP IF NO STEM INFO
RX=Q(J+8)
IF(RX.GT.999.0)GO TO 111
IF(RX.EQ.999.0)RX=0
RX=RX+RT
IF(RX.LT.0)RX=0
C RESET STEM LENGTH. NEVER SHORTER THAN 0 (NORMAL).
Q(J+8)=RX
111 IF(IOCT.LT.0)GO TO 4
C IOCT=-1 FOR OCT+ OR OCT-
RX=AMOD(R,100.0)
RZ=AMOD(RX,7.0)
C THE NOTE NUM
IF(RZ.LT.0)RZ=RZ+7
C PUTS IT IN 0-6 RANGE FOR ACCI CHANGE SECTION.
R5=Q(J+5)
A=AMOD(R5,10.0)
C THE ACCI
RN(MS)=A
RN(MS+1)=RX
C SAVE FOR REPEATS
MS=MS+2
CHNAT=3
IF(MS.LT.203)GO TO 205
N=MS-3
200 IF(RX.NE.RN(N))GO TO 201
IF(A.EQ.0)GO TO 444
C NOW WE'VE FOUND THE SAME NOTE WITH NO ACCI IN SAME MEAS.
GO TO 203
201 N=N-2
IF(N.GE.200)GO TO 200
205 IF(NSIG.LT.0)CHNAT=0
203 ADD=A
C THE CHANGE IN ACCI
IF(PRX.NE.RX)GO TO 44
C IF PREV ACCI AND NT ARE SAME, SKIP OVER.
IF(A.NE.0)GO TO 44
C NOW SAME NOTE, NO ACCI
IF(ABS(SLUR-Q(J+3)).GT.3)GO TO 44
C FOUND CONNECTING TIE
C THIS ↑↑↑↑ ALWAYS PUTS ACCI AFTER A BAR -- EVEN WITH TIE------
C OR SET MS BACK TO 200 WHEN TIE IS PRESENT. THIS WILL
CAUSE LATER SAME NOTE TO HAVE ACCI (I HOPE.)
IF(BAR.LT.0)MS=200
IF(A.NE.0)GO TO 203
GO TO 444
44 IF(NSIG.LT.0)GO TO 440
CCC IF(ITR.GE.17)GO TO 69
IF(A.EQ.0)GO TO 444
C ONLY CHECKS ON NOTES WITH NO ACCI
IF(ITR.GE.18)GO TO 444
440 IF(CLEF.NE.1)GO TO 69
RZ=RZ-5
IF(RZ.LT.0)RZ=RZ+7
CC69 GO TO (63,52,53,54,55, 56,57,58,59,440, 61,62,63,52,53,55
69 N=A+1
GO TO (63,52,64,54,55, 56,57,58,59,440, 61,62,63,52,53,55
1 ,64),ITR
C EEb,EE,F↓,F#↓,G, Ab,A,Bb,B,DMY, Db,D,Eb,E,F,G↑ BBb
54 IF(RZ.EQ.3)GO TO 101
59 IF(RZ.EQ.6)GO TO 101
52 IF(RZ.EQ.2)GO TO 101
57 IF(RZ.EQ.5)GO TO 101
C FOR "A". FINDS C,F AND G.
62 IF(RZ.EQ.1)GO TO 101
55 IF(RZ.EQ.4)GO TO 101
C "G" F→Bb, F#→B NAT.
GO TO 4
61 IF(RZ.EQ.5)GO TO 7
56 IF(RZ.EQ.2)GO TO 7
63 IF(RZ.EQ.6)GO TO 7
58 IF(RZ.EQ.3)GO TO 7
53 IF(RZ.NE.0)GO TO 4
7 GO TO(402,30,405,402,401)N
CIRC7 IF(A.EQ.0)GO TO 402
CIRC IF(A.EQ.3)GO TO 402
C CHNG NO ACCI OR NAT TO SHARP
CIRC IF(A.EQ.4)GO TO 401
C 4=bb 5=##
CIRC IF(A.EQ.2)GO TO 405
30 ADD=CHNAT
C MAKE IT NAT. IF NEEDED
3 Q(J+5)=R5-A+ADD
4 PRX=RX
C REAL NOTE LEVEL
Q(J+4)=R+XRT
BAR=0
RXT=XRT
100 IF(K.GE.LEND)GO TO 499
K=K+1
GO TO 599
C NEXT FOR BSCLAR.---ADD OTHERS HERE!!!
64 IF(CLEF.EQ.1)XRT=XRT-12
IF(ITR.EQ.3)GO TO 53
GO TO 58
444 IF(ITR.NE.17.AND.ITR.NE.3)GO TO 544
IF(CLEF.EQ.1.)XRT=XRT-12
C FOR HORN AND BS.CLAR CHANGE FROM BASS TO TREB. CLEF
544 IF(RXT.NE.99.)XRT=RXT
C THIS FOR BS.CL. AND HRN. REPEATED NOTES.
GO TO 4
101 GO TO(401,404,30,401,404,402)N
CIRC101 IF(A.EQ.0)GO TO 401
CIRC IF(A.EQ.2)GO TO 30
CIRC IF(A.EQ.3)GO TO 401
CIRC IF(A.EQ.5)GO TO 402
C WON'T HANDLE Gbb→Ab
404 ADD=4
GO TO 3
401 ADD=1
GO TO 3
402 ADD=2
GO TO 3
405 ADD=5
GO TO 3
499 KW=KW+1
IF(KW.LT.JPG)GO TO 199
CALL RVRS(LEND)
C TO REVERSE STEMS, BEAMS AND SLURS
END
SUBROUTINE RVRS(LEND)
COMMON /PX/KPN(1) /Q/Q(1) /XRN/RN(1)
1 /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,IRV,ITR
1 /IPG/IPG,JPG,BRA(8),RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(8)
DATA RSTEM/6.5/
KW=0
CZZ IRV=0
CZZ IF(ITR.LT.10)GO TO 100
CZZ IF(ITR.NE.18)IRV=-1
C TRNS ↓ + STEM ↑ = NO CHNG, TRNS ↑ +STEM ↓ = NO CHNG
100 K=1
SN=KW
DO 30 N=1,LEND
IF(CODEN(KPN,N,Q,J).NE.1)GO TO 30
C LOOK FOR NOTES WITH STEM BUT NO RHYTH. VALUE
IF(Q(J+2).NE.SN)GO TO 30
C ON THIS STAFF?
IF(Q(J).LT.7)GO TO 31
IF(Q(J+9).NE.0)GO TO 30
31 IF(Q(J+5).GE.10)GO TO 102
C FOUND A 0 RHYTHM WITH A STEM - IGNORE THIS STAFF
30 CONTINUE
1 R=CODEN(KPN,K,Q,J)
IF(Q(J+2).NE.SN)GO TO 10
CHECK ON STAFF NUM.
IF(R.NE.1)GO TO 2
C JUMP IF NOT A NOTE
CZZ IF(NORVRS(Q(J+5)))GO TO 10
CHECKS STEM DIR. AND TRNS DIR.
IF(Q(J+5).LT.10)GO TO 10
C JUMP IF NO STEM ON IT
IF(Q(J).GT.6.AND.Q(J+9).LT.0)GO TO 10
C SKIP NOTES WITH NO LEDGER LINES
KK=K+1
3 IF(KK.GT.LEND)GO TO 102
RR=CODEN(KPN,KK,Q,JJ)
IF(Q(JJ+2).EQ.SN)GO TO 101
GO TO 7
101 IF(RR.NE.1)GO TO 5
C JUMP IF NOT A NOTE
IF(Q(JJ+5).GE.10)GO TO 6
C SKIP CHORD NOTES (NO STEM)
7 KK=KK+1
GO TO 3
C DID NOT FIND BEAM NEARBY
6 RZ=AMOD(Q(J+4),100.0)
N=J+5
A=10
IF(RZ.GE.7)GO TO 60
IF(Q(N).LT.20)GO TO 10
C NOW STEM SHOULD BE DOWN IF WITHOUT BEAM OR 1ST NT UNDER BEAM.
A=-A
GO TO 15
60 IF(Q(N).GE.20)GO TO 10
C THERE MUST BE A BETTER WAY!
15 Q(N)=Q(N)+A
GO TO 10
CCC5 IF(RR.NE.6)GO TO 6
5 IF(RR.EQ.6)GO TO 20
IF(Q(JJ+3).NE.Q(J+3))GO TO 6
CATCHES OTHER THINGS AT EXACTLY SAME POS. AS NOTE AND BEAM.
KK=KK+1
GO TO 3
20 B=Q(JJ+4)
C=Q(JJ+5)
D=(B+C)/2.
IF(RR.EQ.5)GO TO 9
IF(RR.NE.6)GO TO 10
CALL BMHGT(B,C,JJ)
120 B=Q(JJ+6)+.5
C SAVES RANGE OF BEAM +1.
IF(Q(JJ+7).GE.20)GO TO 11
C NOW STEMS ARE UP
IF(D.LT.RSTEM)GO TO 12
C JUMP TO 12 IF ALL OK
IF(AVERG(K,JJ,LEND).EQ.0)GO TO 12
C JUMP IF NOTE LEVELS DO NOT CALL FOR REVERSED STEMS
JSTM=0
C SAVE FOR REVERSED STEMS
GO TO 23
11 IF(D.GE.RSTEM)GO TO 12
C STEMS DOWN
C JUMP IF NO REVERSE NEEDED
IF(AVERG(K,JJ,LEND).NE.0)GO TO 12
C JUMP IF NOTE LEVELS DO NOT CALL FOR REVERSED STEMS
JSTM=-1
23 JH=0
CHNG=0
N=K
164 R=CODEN(KPN,N,Q,KK)
IF(Q(KK+2).NE.SN)GO TO 16
IF(Q(KK+3).GT.B)GO TO 140
IF(R.NE.1)GO TO 17
L=5+KK
IF(Q(L).LT.10)GO TO 16
C PASS NOTES WITH NO STEM
R=Q(KK+8)
C THE STEM LENGTH
IF(R.EQ.999)R=0
Q(KK+8)=-R
C FOR THE INVERSION
19 BC=10.
A=Q(L)
IF(A.GE.20)BC=-BC
Q(L)=BC+A
IF(JH.NE.0)GO TO 161
C NEXT FOR 1ST NOTE UNDER BEAM
JH=4
160 R=Q(JJ+JH)-Q(KK+4)
A=-1
IF(JSTM.LT.0)GO TO 163
A=R
R=1
C NOW STEMS UP
163 IF(R.GT.A)GO TO 162
C JUMP IF BEAM IS NOT TOO CLOSE TO NOTE
CHNG=A-R
IF(JSTM.EQ.0)CHNG=-CHNG
162 IF(L.LT.0)GO TO 141
C FOR ESCAPE FROM LOOP
161 JH=KK
C JH SAVES PTR TO LAST NOTE UNDER BEAM
GO TO 16
17 IF(R.NE.6)GO TO 18
C NOW IT'S A BEAM
L=7+KK
CALL BMHGT(Q(KK+4),Q(KK+5),KK)
GO TO 19
18 IF(R.NE.5)GO TO 16
C NOW IT'S A SLUR
C=-4
IF(Q(KK+8).LT.-1)C=-1.8
IF(Q(KK+7).LT.0)C=-C
CALL SLRV(KK,C)
C TO REVERSE SLUR
16 N=N+1
IF(N.LE.LEND)GO TO 164
C SHOULD ALWAYS EXIT FROM LOOP BEFORE END OF ARRAY!
140 KK=JH
L=-1
JH=5
C GO BACK TO CHECK HGT OF LAST NOTE AND RIGHT END OF BEAM
GO TO 160
141 IF(CHNG.EQ.0)GO TO 14
C=CHNG
IF(CHNG.LT.0)CHNG=-CHNG
DO 142 N=K,LEND
C TO READJUST STEMS UNDER REVERSED BEAMS
R=CODEN(KPN,N,Q,KK)
IF(Q(KK+2).NE.SN)GO TO 142
IF(Q(KK+3).GT.B)GO TO 14
CC IF(R.NE.1)GO TO 242
CC Q(KK+8)=Q(KK+8)+CHNG
C THE STEM LENGTH
CC GO TO 142
242 IF(R.NE.6)GO TO 142
Q(KK+4)=Q(KK+4)+C
Q(KK+5)=Q(KK+5)+C
142 CONTINUE
GO TO 14
C NEXT FOR SLURS
9 B=-4
IF(Q(JJ+8).LT.-1)B=-1.8
IF(Q(JJ+7).LT.0)GO TO 24
IF(D.GT.RSTEM)GO TO 10
C JUMP TO LEAVE STEM UP
GO TO 25
24 IF(D.LT.5)GO TO 10
C JUMP TO LEAVE STEM DOWN
B=-B
25 CALL SLRV(JJ,B)
GO TO 10
12 DO 13 N=K+1,LEND
KK=KPN(N)
IF(Q(KK+2).NE.SN)GO TO 13
C IS THIS NEEDED↑↑↑↑??
IF(Q(KK+3).GT.B)GO TO 14
IF(Q(KK+1).EQ.6.)CALL BMHGT(Q(KK+4),Q(KK+5),KK)
13 CONTINUE
C JUMP OUT WHEN PAST END OF BEAM.
14 IF(N.GT.K)K=N-1
C ↑↑↑↑↑↑ WHY????????????
GO TO 10
2 IF(R.NE.6)GO TO 21
CZZ IF(NORVRS(Q(J+7)))GO TO 10
22 JJ=J
RR=R
GO TO 20
CZZ21 IF(R.NE.5)GO TO 10
CZZ RR=20
CZZ IF(Q(J+7))RR=10
CZZ IF(NORVRS(RR).GE.0)GO TO 22
21 IF(R.EQ.5)GO TO 22
10 IF(R.NE.1)GO TO 202
C NEXT FIXES STEM LENGTHS
B=0
A=AMOD(Q(J+4),100.0)
IF(A.GE.80)A=A-100.
C A=HEIGHT OF NOTE
IF(Q(J+5).GE.20.)GO TO 302
C JUMP IF STEMS ARE DOWN
IF(A.LT.0)B=-A
C LENGTHEN STEM IF NOTE IS TOO FAR BELOW STAFF
GO TO 402
302 IF(A.GT.14)B=A-14.
402 Q(J+8)=B
202 IF(K.GT.LEND)GO TO 102
K=K+1
GO TO 1
102 KW=KW+1
IF(KW.LT.JPG)GO TO 100
END
CZZ FUNCTION NORVRS(R)
CZZ COMMON /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,IRV,ITR
CZZ NORVRS=0
CZZ IF(R.LT.20)GO TO 1
C NOW STEM UP
CZZ IF(IRV)RETURN
CZZ2 NORVRS=-1
CZZ RETURN
CZZ1 IF(IRV)GO TO 2
CZZ END
SUBROUTINE BMHGT(B,C,JJ)
COMMON /Q/Q(1)
BB=0
IF(ABS(B).LT.80)GO TO 1
C JUMP IF NOT MINI-BEAM
BB=B-100.
IF(B.LT.0)BB=B+100.
B=BB
1 BC=ABS(Q(JJ+7))
IF(BC.GE.20.)GO TO 121
IF(B.GE.0.AND.C.GE.0)RETURN
C NEXT TO CHANGE HGT. OF BEAMS TOO HIGH OR TOO LOW.
BC=-C
IF(B.LT.C)BC=-B
C -B IF C IS LOWEST
122 IF(BB.NE.0)B=B+100.
Q(JJ+4)=B+BC
Q(JJ+5)=C+BC
C BOTH SIDES ARE NOW SHIFTED
RETURN
121 IF(B.LE.14.AND.C.LE.14)RETURN
C NOW AT LEAST ONE SIDE IS TOO HIGH
BC=14-C
IF(B.GT.C)BC=14-B
GO TO 122
END
SUBROUTINE CUES
COMMON /PX/KPN(1)/XRN/RN(1)/PTR/KWDS(1)/RCLF/KK,CLEF,KW,ITEM
1 /LLL/LLL /Q/Q(1)
DO 1 K=LLL,1,-1
C BACK THROUGH ARRAY FROM LAST CUE FOUND.
IF(CODEN(KPN,K,Q,J).NE.2)GO TO 1
C NEXT FOUND A REST
IF(Q(J).LT.8)GO TO 1
C JUMP IF WDCNT IS TOO SMALL
IF(Q(J+10).LT.100)GO TO 1
C P10=100+STAFF NUM. OF CUE DATA. JUMP IF IMPROPER NUM.
STF=Q(J+10)-100.
POS=Q(J+3)
C POSITION OF THIS REST
PLEFT=0
PRGHT=1000
C POSITIONS FOR BARS TO LEFT AND RIGHT. NEXT FIND PROPER BARS.
DO 2 L=1,ITEM
IF(CODEN(KWDS,L,RN,N).NE.4)GO TO 2
C FIND A BAR AND ITS POS.
X=RN(N+3)
IF(X.GT.POS)GO TO 3
C IS TO LEFT OR RIGHT OF REST?
IF(X.GT.PLEFT)PLEFT=X
GO TO 2
3 IF(X.LT.PRGHT)PRGHT=X
2 CONTINUE
C NOW FOUND BARS ON EACH SIDE OF REST.
DO 4 L=1,ITEM
C NOW FIND NOTES WITHIN PROPER BAR AND ON PROPER STAFF
R=CODEN(KWDS,L,RN,N)
IF(RN(N+2).NE.STF)GO TO 4
RS=RN(N+3)
C POS. OF ITEM.
IF(RS.GT.PRGHT)GO TO 4
IF(RS.LT.PLEFT)GO TO 4
C NOW BETWEEN BARS.
IF(R.GT.6)GO TO 4
C USE NOTES,RESTS,CLEFS,SLURS,BEAMS
IF(R.NE.5)RN(N+4)=RN(N+4)+100.
C MAKE ALL MINIS AND PUT ON STAFF 0
RN(N+2)=0
IF(R.GT.2)GO TO 5
JJ=N+11-R*2.0
RN(JJ)=RN(JJ)/2.
C JJ=9 OR 7. CUT RHYTH VALS OF CUES 1/2 - SO THEY WILL OCCUPY LESS SPACE.
5 CALL QRN(N,KPN,L)
C GO PUT IT INTO Q ARRAY
4 CONTINUE
CC Q(J+3)=POS+1
C SHIFT THE WHOLE REST A BIT TO THE RIGHT.
Q(J+10)=0
Q(J+4)=5.
C PUT IT ABOVE STAFF.
Q(J+5)=-2
C P5=-2=WHOLE REST
Q(J+9)=0
CC Q(J+8)=-1.
Q(J+7)=-1.
C NEG. RHYTHM MAKES REST IGNORED BY ALL JUSTIFYING ROUTINES.
1 CONTINUE
END